home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dskut / execut10.zip / EXECUTOR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-24  |  3.9 KB  |  133 lines
  1. program Executor;
  2.  
  3. {$M 16384 0 8192}
  4.  
  5. uses dos;
  6.  
  7. const maxlong = 500;
  8.  
  9. var f : text;
  10.     fich : file;
  11.     s : string;
  12.     i, num : integer;
  13.     tab : array[1..maxlong] of string[12];
  14.     ext, arch, archiver, command, temp : string;
  15.     rec : searchrec;
  16.     fi : word;
  17.     del : boolean;
  18.  
  19. begin
  20.    writeln('Executor 1.0 - (C) March 1993 V. D''Haeyere');
  21.    writeln('');
  22.    if not(paramcount in [1..3])
  23.       then begin
  24.               writeln('Archives each file terminated by a common extension in a archive file');
  25.               writeln('derived from the original name.');
  26.               writeln;
  27.               writeln('If the /D option is used, the original files are also deleted.');
  28.               writeln('');
  29.               writeln('Command : EXECUTOR <ext> [<archiver>] [/D]');
  30.               writeln('          Archive all the files with extension <ext> with');
  31.               writeln('          the archiver <archiver>.');
  32.               writeln('          Optionally deletes the original files (with /D)');
  33.               writeln;
  34.               writeln('By default, the archiver is set to LHA and files are NOT deleted.');
  35.               writeln('Other supported archivers are PKZIP, ZOO, ARJ, ARC, PKARC. The archiver');
  36.               writeln('should be located somewhere on your path or in the current directory.');
  37.               writeln;
  38.               writeln('>>> Very few error checking is made, and its not garanteed to be bug free...');
  39.               writeln;
  40.               writeln('This program is freeware (who would pay for it anyway ???) !');
  41.               halt(0)
  42.       end;
  43.  
  44.    ext:=paramstr(1);
  45.    if length(ext)>3
  46.       then begin
  47.               writeln('Error : an extension is made of up to 3 characters');
  48.               halt(1)
  49.            end;
  50.  
  51.    archiver:='LHA';
  52.    command:='a';
  53.    del:=false;
  54.  
  55.    if paramcount>1 then
  56.    begin
  57.       temp:=paramstr(2);
  58.       if (temp='/D') or (temp='/d')
  59.          then del:=true
  60.          else archiver:=temp
  61.    end;
  62.  
  63.    if (paramcount=3)
  64.       and ((paramstr(3)='/d') or (paramstr(3)='/D'))
  65.           then del:=true;
  66.  
  67.    for i:=1 to length(archiver)
  68.       do archiver[i]:=upcase(archiver[i]);
  69.  
  70.    if archiver='LHA'
  71.       then command:='a'
  72.    else if archiver='PKZIP'
  73.         then command:='-a'
  74.    else if archiver='PKARC'
  75.         then command:='a'
  76.    else if archiver='ZOO'
  77.         then command:='a'
  78.    else if archiver='ARJ'
  79.         then command:='a'
  80.    else if archiver='ARC'
  81.         then command:='a'
  82.    else begin
  83.            writeln('Archiver unsupported...');
  84.            writeln('Supported archivers are LHA, PKZIP, ZOO, ARC, ARJ, PKARC.');
  85.            halt(0)
  86.         end;
  87.  
  88.    i:=1;
  89.    fi:=(anyfile and not(Hidden) and not(VolumeID) and not(Directory) and not(SysFile));
  90.    findfirst('*.'+ext, fi, rec);
  91.    while (doserror=0) and (i<=maxlong) do
  92.    begin
  93.       tab[i]:=rec.name;
  94.       inc(i);
  95.       findnext(rec)
  96.    end;
  97.  
  98.    if i>maxlong then
  99.    begin
  100.       writeln('');
  101.       writeln('Only the 500 first files terminated by the extension '+ext);
  102.       writeln('will be processed...')
  103.    end;
  104.    num:=pred(i);
  105.  
  106.    if num>0
  107.       then writeln(num,' file(s) are going to be processed...')
  108.       else writeln('Nothing to do !');
  109.  
  110.    arch := FSearch(archiver+'.EXE','.;'+GetEnv('PATH'));
  111.    if arch='' then
  112.    begin
  113.       writeln('Error : the archiver could not be located on your path , nor in');
  114.       writeln('the current directory.');
  115.       halt(1)
  116.    end;
  117.  
  118.    for i:=1 to num do
  119.    begin
  120.       s:=copy(tab[i],1, pred(pos('.',tab[i])));
  121.       writeln('File '+s+'.'+ext+' being processed...');
  122.       writeln;
  123.       exec(arch, command+' '+s+' '+s+'.'+ext);
  124.       if del then
  125.       begin
  126.          assign(fich, s+'.'+ext);
  127.          erase(fich);
  128.          writeln('File '+s+'.'+ext+' is deleted...');
  129.          writeln;
  130.       end
  131.    end;
  132.    if num>0 then writeln('Job done...')
  133. end.